home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / XLISP 2.0 / XLISP Tools / Utility (UL) / MATH.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1988-04-07  |  2.8 KB  |  94 lines  |  [TEXT/ttxt]
  1. ;; Larry Mulcahy 1988
  2. ;; math functions
  3.  
  4. (provide 'math)
  5.  
  6. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  7. ; macro incf 
  8. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  9.  
  10. (defmacro incf (x)
  11.   `(setf ,x (1+ ,x)))
  12.  
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14. ; macro decf 
  15. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  16.  
  17. (defmacro decf (x)
  18.   `(setf ,x (1- ,x)))
  19.  
  20. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21. ; trim-float 
  22. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23.  
  24. (defun trim-float (x digits)
  25.   (let ((magnitude (expt 10 digits)))
  26.     (/ (fround (* x magnitude)) magnitude)))
  27.   
  28. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29. ; floor 
  30. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  31.  
  32. (defun floor (number &optional divisor)
  33.   (if divisor
  34.       (floor (/ number divisor))
  35.       (if (integerp number)
  36.           number
  37.           (if (> number 0.0)
  38.               (truncate number)
  39.               (truncate (- number 1.0))))))
  40.  
  41. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  42. ; ceiling 
  43. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  44.  
  45. (defun ceiling (number &optional divisor)
  46.   (if divisor
  47.       (round (/ number divisor))
  48.       (if (integerp number)
  49.           number
  50.           (if (< number 0.0)
  51.               (truncate number)
  52.               (truncate (+ number 1.0))))))
  53.  
  54. ;XLISP provides a TRUNCATE function
  55. ;(defun truncate (number &optional divisor))
  56.  
  57. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  58. ; round 
  59. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  60.  
  61. (defun round (number &optional divisor)
  62.   (if divisor
  63.       (round (/ number divisor))
  64.       (if (integerp number)
  65.           number
  66.           (if (> number 0.0)
  67.               (truncate (+ number 0.5))
  68.               (truncate (- number 0.5))))))
  69.  
  70. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  71. ; ffloor 
  72. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  73.  
  74. (defun ffloor (&rest args) (float (apply #'floor args)))
  75.  
  76. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  77. ; fceiling 
  78. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  79.  
  80. (defun fceiling (&rest args) (float (apply #'ceiling args)))
  81.  
  82. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  83. ; ftruncate 
  84. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  85.  
  86. (defun ftruncate (&rest args) (float (apply #'truncate args)))
  87.  
  88. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  89. ; fround 
  90. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  91.  
  92. (defun fround (&rest args) (float (apply #'round args)))
  93.  
  94.